Garbo/Garbo.cdr/mac/hypercrd/xcmd/dxcmds34.sit/Dartmouth XCMD's 3.4.3/card_4672.txt

Text File | 1990-04-17 | 16KB | 466 lines

-- card: 4672 from stack: in.3
-- bmap block id: 0
-- flags: 4000
-- background id: 3241
-- name: FileToField
----- HyperTalk script -----
on Install
  get ChooseTargetStack()
  InstallResource XCMD,FileToField,it
end Install


-- part 1 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=79 top=300 right=322 bottom=179
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: FileToField
----- HyperTalk script -----
on mouseUp
  FileToField "card field 1"
  get the result
  if it is not empty then put it
  if "Cancel" is not in it and "Error" is not in it then
    show card field 1
    set the visible of card button 2 to true
  end if
end mouseUp



-- part 2 (field)
-- low flags: 81
-- high flags: 2007
-- rect: left=265 top=33 right=296 bottom=486
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 20
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: FileToField Text


-- part 3 (button)
-- low flags: 80
-- high flags: A003
-- rect: left=284 top=268 right=290 bottom=458
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Empty and Hide this Field
----- HyperTalk script -----
on mouseUp
  set lockscreen to true
  put empty into card field 1
  hide card field 1
  set the visible of me to false
  -- doMenu "Compact Stack"
  set lockscreen to false
end mouseUp



-- part 6 (field)
-- low flags: 81
-- high flags: 2007
-- rect: left=12 top=26 right=298 bottom=491
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 22
-- text size: 10
-- style flags: 0
-- line height: 13
-- part name: Source


-- part 8 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=299 top=300 right=322 bottom=438
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Show Pascal Source
----- HyperTalk script -----
on mouseUp
  set the visible of card field 2 to not the visible of card field 2
  if the visible of card field 2 is true then
    set the name of me to "Hide Pascal Source"
  else set the name of me to "Show Pascal Source"
end mouseUp



-- part contents for background part 16
----- text -----
FILETOFIELD XCMD version 1.5
Kevin Calhoun

The FileToField XCMD copies the contents of a text file into a HyperCard field.  You may choose the text file to copy from by selecting it from a standard file dialog box or by specifying its full pathname.

If the text file is too large (just under 30K is the practical limit for HyperCard fields), FileToField won't try to copy it into the field.  If this or any other error occurs, FileToField will return an error message as the result.  Word 1 of this message will be "Error".  If the text was copied successfully, FileToField returns the full pathname of the file as the result.

INVOKING FILETOFIELD

FileToField "fieldDesignation",<"full pathname of file">

You may designate the field into which the text is to be copied in any way considered valid by HyperCard, by number, id, or name, with one exception:  you can't use the field's name if it is more than one word.  If you do use the field's name, don't put the field name in quotation marks.  Nested quotations confuse HyperCard.  (See the examples below.)

If you don't supply the pathname of the file to be copied from, FileToField will invoke SFGetFile, and the user can select the file from the dialog box.  If the user pushes the cancel button of the dialog box, FileToField returns "Cancel" as the Result.

examples--

FileToField("card field 1")                --these examples copy files chosen from the
FileToField("bkgnd field id 16")       --standard file dialog into the specified field
FileToField("card field Memorex")

FileToField "field 5","OldAchesAndPains:Good Stuff:Secrets"  --this copies the file
"Secrets" into background field 5.

REVISION HISTORY
7 March 1988: release of version 1.0
31 March 1988: release of version 1.1
  --better reporting of memory errors
  --more compact code
16 May 1988: release of version 1.2
  -- fixed bug that bombed Mac Plus (switched from PBHOpen to FSOpen)
15 March 1989 -- 1.5
  -- Altered source code for compatibility with MPW Pascal 3.0.

-- part contents for card part 6
----- text -----
UNIT FileToFieldUnit;

{ FileToField XCMD © 1988-1989 by the Trustees of Dartmouth College }
{ Written by Kevin Calhoun }

{ This source compatible with MPW Pascal 3.0 }

(*
Pascal FileToField.p
Link -m ENTRYPOINT Γêé
     -o "YourFile" Γêé
     -rt XCMD=2235 Γêé
     -sn Main=FileToField Γêé
     FileToField.p.o Γêé
    "{Libraries}"interface.o Γêé
    "{PLibraries}"Paslib.o Γêé
    "{Libraries}"HyperXLib.o
*)

{$R-}

INTERFACE
  USES
    Types,
    Memory,
    Files,
    Resources,
    Packages,
    HyperXCmd;

  PROCEDURE EntryPoint (paramPtr : XCmdPtr);

IMPLEMENTATION

  PROCEDURE FileToField(paramPtr : XCmdPtr); FORWARD;

  PROCEDURE EntryPoint(paramPtr : XCmdPtr);
  BEGIN
    FileToField(paramPtr);
  END;

  FUNCTION GetScreenBitsBounds: Rect;
  { get screenbits.bounds from the QuickDraw globals }
  TYPE
    LongwordPtr = ^LONGINT;
    BitMapPtr = ^BitMap;
  CONST
    screenBitsOffset = -122;
    CurrentA5 = $904;
  VAR
    screenBitsPtr : BitMapPtr;
    myLongwordPtr : LongwordPtr;
  BEGIN
    myLongwordPtr := LongwordPtr(CurrentA5);
      { myLongwordPtr now points to the pointer to the first QD global }
    myLongwordPtr := LongwordPtr(myLongwordPtr^);
      { myLongwordPtr now points to the first QD global }
    screenBitsPtr := BitMapPtr(myLongwordPtr^ + screenBitsOffset);
      { screenBitsPtr now points to the screenBits BitMap }
    GetScreenBitsBounds := screenBitsPtr^.bounds;
  END;

  FUNCTION BuildThePathname (fName : Str255;
                  vRefNum : INTEGER) : Str255;
{ Given the "short name" and vRefNum of a file, returns the full pathname. }
{ This function is adapted from Steve Maller's FileName XFCN published in }
{ HyperTalk Programming by Dan Shafer, Howard W. Sams & Company, 1988, }
{ pp. 399-403. }
    VAR
      name, fullPathName : Str255;
      err : INTEGER;
      myWDPB : WDPBPtr;
      myCPB : CInfoPBPtr;
      myPB : HParmBlkPtr;

  BEGIN
    fullPathName := '';     { start with an empty pathname }
{ Allocate some memory in the heap for the parameter block. }
    myCPB := CInfoPBPtr(NewPtr(SizeOf(HParamBlockRec)));
    IF ord4(myCPB) > 0 THEN    { continue if mem allocation was OK }

      BEGIN
        myWDPB := WDPBPtr(myCPB);
        myPB := HParmBlkPtr(myCPB);
{ same pointer, different variations of the record -- see IM IV, p. 117 }
        name := '';     { start with an empty name for the volume }

        WITH myPB^ DO
          BEGIN
            ioNamePtr := @name;   { we want the volume name }
            ioCompletion := pointer(0);
            ioVRefNum := vRefNum;  { returned by SFGetFile }
            ioVolIndex := 0;  { use the vRefNum and name only to designate volume }
          END;
        err := PBHGetVInfo(myPB, FALSE);  { fill in the volume info }
        IF err = noErr THEN

          BEGIN
{ Now we need the Working Directory (WD) information because we're }
{ going to step backwards from the file through all of the folders until }
{ we reach the root directory. }
            WITH myWDPB^ DO
              BEGIN
                ioVRefNum := vRefNum;  { this got set to 0 above }
                ioWDProcID := 0;   { use the vRefNum }
                ioWDIndex := 0;     { we want all directories }
              END;
            err := PBGetWDInfo(myWDPB, FALSE);
            IF err = noErr THEN
              BEGIN
                WITH myCPB^ DO
                  BEGIN
                    ioFDirIndex := -1;   { use the ioDirID field only }
                    ioDrDirID := myWDPB^.ioWDDirID;   { info returned above }
                  END;
                err := PBGetCatInfo(myCPB, FALSE);
                IF err = noErr THEN
                  BEGIN

{ Here starts the real work -- start to climb the tree by continually }
{ looking in the ioDrParID field for the next directory above until we fail... }
                    myCPB^.ioDrDirID := myCPB^.ioDrParID;  { the first folder }
                    fullPathName := CONCAT(myCPB^.ioNamePtr^, ':', fName);
                    REPEAT
                      myCPB^.ioDrDirID := myCPB^.ioDrParId;
                      err := PBGetCatInfo(myCPB, FALSE);    { the next level }
{ Be careful of an error returned here -- it means the user chose a file on the }
{ desktop level of this volume.  If this is the case, just stop here and return }
{ "VolumeName:FileName"; otherwise loop until failure. }
                      IF err = noErr THEN
                        fullPathName := CONCAT(myCPB^.ioNamePtr^, ':', fullPathName);
                    UNTIL err <> noErr;
                  END;  { if PBGetCatInfo worked OK }
              END;  { if PBGetWDInfo worked OK }
          END;  { if PBHGetVInfo worked OK }
        DisposPtr(pointer(myCPB));
      END;  { if we had enough room for a new pointer }
    BuildThePathname := fullPathName;
  END;

  PROCEDURE PassReturnValue (paramPtr : XCMDPtr;
                  theMsg : Str255); { set theResult }
  BEGIN
    paramPtr^.returnValue := PasToZero(paramPtr, theMsg);
  END;

  PROCEDURE SetField (paramPtr : XCmdPtr;
                  theStringPtr : Ptr;
                  theTextHandle : handle);
    VAR
      whichField, theString : Str255;
      cardFieldFlag : BOOLEAN;
      matchPtr : Ptr;
      theResult : Handle;
      fieldID : INTEGER;

  BEGIN
{ get Pascal string that contains designation of field to be printed }
    ZeroToPas(paramPtr, theStringPtr, whichField);
{ get long name of this field to see if it's a card or bkgnd field }
    theResult := EvalExpr(paramPtr, CONCAT('the long name of ', whichField));
    IF (paramPtr^.result = noErr) THEN
      BEGIN
        MoveHHi(theResult);
        HLock(theResult);

{ see if this thing actually is an extant field }
{ if HC returns a long field name with the word 'card' in it, we'll assume it's real }
        matchPtr := StringMatch(paramPtr, 'card', theResult^);

        IF (matchPtr <> NIL) AND (paramPtr^.result = noErr) THEN  { this must be a field after all }
          BEGIN
{ check to see if name of field contains 'card field' -- so we can set the cardFieldFlag }
            matchPtr := StringMatch(paramPtr, 'card field', theResult^);
            cardFieldFlag := (matchPtr <> NIL);
{ free the space allocated by EvalExpr above }
            DisposHandle(theResult);

{ get the id of this field }
            theResult := EvalExpr(paramPtr, CONCAT('the id of ', whichField));
            IF (theResult <> NIL) AND (paramPtr^.result = noErr) THEN
              BEGIN
                MoveHHi(theResult);
                HLock(theResult);
{ convert it into a string, then into a number }
                ZeroToPas(paramPtr, theResult^, theString);
                fieldID := StrToNum(paramPtr, theString);
                DisposHandle(theResult);  { and free the memory allocated by EvalExpr }

                SetFieldByID(paramPtr, cardFieldFlag, fieldID, theTextHandle);
              END;
{ set the contents of the field to the contents of theTextHandle }
          END;
      END;
    IF GetHandleSize(theResult) <> 0 THEN DisposHandle(theResult);
  END;

  PROCEDURE FileToField (paramPtr : XCmdPtr);
    VAR
      reply : SFReply;   { returned by SFGetFile }
      fileName : Str255;  { name of file to open }
      theVRefNum : INTEGER;  { ref num of volume (or directory) on which the file resides }
      theRefNum : INTEGER;  { refNum of file, for file manager calls }
      err : OSErr;  { save error codes for reporting trouble }
      logEOF : longint;   { length of file }
      theBufHndl : Handle;  { for copying contents of file into memory }
      zeroPtr: Ptr;
      parameterCount : INTEGER;  { the number of parameters passed to us }
      didSFGet : BOOLEAN;
      numStr : Str255;

    PROCEDURE DoSFGet;
      VAR
        where : point;
        typeList : SFTypeList;
        dlgt: DialogTHndl;
        r: rect;
        screen: rect;
        h, v: INTEGER;
    BEGIN  { select text file to read using SFGetFile }
      dlgt := DialogTHndl(GetResource('DLOG',getDlgID));
      if dlgt <> nil then
        begin
        r := dlgt^^.boundsRect;
        screen := GetScreenBitsBounds;
        h := ((screen.right - screen.left) - (r.right - r.left)) div 2;
        v := ((screen.bottom - screen.top) - (r.bottom - r.top)) div 2;
        SetPt(where, h, v);
        end
      else SetPt(where, 82, 75);
      typeList[0] := 'TEXT';  { tell SFGetFile to display only text files }
      SFGetFile(where, '', NIL, 1, typeList, NIL, reply);
    END;

    FUNCTION GetFileName : Str255;
           { return the name of the file to copy from }
      VAR
        temp : Str255;
    BEGIN
      IF parameterCount > 1 THEN
        BEGIN
          ZeroToPas(paramPtr, paramPtr^.params[2]^, temp);
          didSFGet := FALSE;
        END
      ELSE
        BEGIN
          doSFGet;
          IF reply.good = TRUE THEN temp := reply.fName
          ELSE temp := '';
          didSFGet := TRUE;
        END;
      GetFileName := temp;
    END;

  BEGIN
    parameterCount := paramPtr^.paramCount;
    IF parameterCount > 0 THEN
      BEGIN
        fileName := GetFileName;
        IF fileName <> '' THEN
          BEGIN
            IF didSFGet THEN theVRefNum := reply.vRefNum
            ELSE theVRefNum := 0;
            err := FSOpen(fileName, theVRefNum, theRefNum);
            IF err = noErr THEN
              BEGIN
                err := GetEOF(theRefNum, logEOF);
                IF err = noErr THEN
                  IF logEOF < 29990 THEN
{ 29990 bytes is my experimental value for the maximum safe size of HC fields }
                    BEGIN
                      theBufHndl := NewHandle(logEOF);
                      err := MemError;
                      IF (theBufHndl <> NIL) AND (err = noErr) THEN
                        BEGIN
                          MoveHHi(theBufHndl);
                          HLock(theBufHndl);
                          err := FSRead(theRefNum, logEOF, theBufHndl^);
                          IF err = noErr THEN
                            BEGIN
                              HUnlock(theBufHndl);
                              SetHandleSize(theBufHndl,logEOF+1);
                              zeroPtr := Ptr(ORD4(theBufHndl^)+logEOF);
                              zeroPtr^ := 0;
                              IF err = noErr THEN
                                BEGIN
                                  SetField(paramPtr, paramPtr^.params[1]^, theBufHndl);
                                  IF didSFGet THEN
                                    fileName := BuildThePathname(fileName, theVRefNum);
                                  PassReturnValue(paramPtr, fileName);
                                END;
                            END;
                          DisposHandle(theBufHndl);
                        END   { if theBufHndl <> nil }
                      ELSE
                        BEGIN
                        NumToStr(paramPtr, err,numStr);
                        PassReturnValue(paramPtr, CONCAT('Error ', numStr));
                        END;
                    END        { if the file wasn't too big to read in }
                  ELSE PassReturnValue(paramPtr, 'Error (file too big)');
                err := FSClose(theRefNum);
              END;   { if err = noErr in opening the file }
            IF err <> noErr THEN   { if we had an error, report it }
              BEGIN
              NumToStr(paramPtr, err,numStr);
              PassReturnValue(ParamPtr, CONCAT('Error ', numStr));
              END;
          END
        ELSE PassReturnValue(paramPtr, 'Cancel');
      END  { if we got parameters }
    ELSE
      PassReturnValue(paramPtr, 'FileToField XCMD 1.5, 15 March 1989, ©1988-1989 Dartmouth College');
  END;


END.